home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / By the Book / Mac Pascal Primer, 4.0 / Chap 7, Pager ƒ / Pager.p next >
Text File  |  1990-07-28  |  6KB  |  241 lines
  1. program Pager;
  2.     const
  3.         BASE_RES_ID = 400;
  4.  
  5.         SCROLL_BAR_PIXELS = 16;
  6.  
  7.         MIN_SLEEP = 0;
  8.         NIL_REF_CON = 0;
  9.  
  10.         WNE_TRAP_NUM = $60;
  11.         UNIMPL_TRAP_NUM = $9F;
  12.  
  13.         ERROR_ALERT_ID = BASE_RES_ID + 1;
  14.         NO_WIND = BASE_RES_ID;
  15.         NO_PICTS = BASE_RES_ID + 1;
  16.         CANT_LOAD_PICT = BASE_RES_ID + 2;
  17.  
  18.         NIL_STRING = '';
  19.         NIL_TITLE = NIL_STRING;
  20.         VISIBLE = TRUE;
  21.         START_VALUE = 1;
  22.         MIN_VALUE = 1;
  23.         HOPELESSLY_FATAL_ERROR = 'Game over, man!';
  24.  
  25.     var
  26.         gPictWindow: WindowPtr;
  27.         gScrollBarHandle: ControlHandle;
  28.         gDone, gWNEImplemented: BOOLEAN;
  29.         gTheEvent: EventRecord;
  30.  
  31.  
  32. {-------------------------------->    ErrorHandler    <---}
  33.  
  34.     procedure ErrorHandler (stringNum: INTEGER);
  35.         var
  36.             errorStringH: StringHandle;
  37.             dummy: INTEGER;
  38.     begin
  39.         errorStringH := GetString(stringNum);
  40.         if errorStringH = nil then
  41.             ParamText(HOPELESSLY_FATAL_ERROR, NIL_STRING, NIL_STRING, NIL_STRING)
  42.         else
  43.             ParamText(errorStringH^^, NIL_STRING, NIL_STRING, NIL_STRING);
  44.  
  45.         dummy := StopAlert(ERROR_ALERT_ID, nil);
  46.         ExitToShell;
  47.     end;
  48.  
  49.  
  50. {-------------------------------->    CenterPict    <---}
  51.  
  52.     procedure CenterPict (thePicture: PicHandle; var myRect: Rect);
  53.         var
  54.             windRect, pictureRect: Rect;
  55.     begin
  56.         windRect := myRect;
  57.         pictureRect := thePicture^^.picFrame;
  58.         myRect.top := (windRect.bottom - windRect.top - (pictureRect.bottom - pictureRect.top)) div 2 + windRect.top;
  59.         myRect.bottom := myRect.top + (pictureRect.bottom - pictureRect.top);
  60.         myRect.left := (windRect.right - windRect.left - (pictureRect.right - pictureRect.left)) div 2 + windRect.left;
  61.         myRect.right := myRect.left + (pictureRect.right - pictureRect.left);
  62.     end;
  63.  
  64.  
  65. {-------------------------------->    UpdateMyWindow    <---}
  66.  
  67.     procedure UpdateMyWindow (drawingWindow: WindowPtr);
  68.         var
  69.             currentPicture: PicHandle;
  70.             drawingClipRect, myRect: Rect;
  71.             tempRgn: RgnHandle;
  72.     begin
  73.         tempRgn := NewRgn;
  74.         GetClip(tempRgn);
  75.  
  76.         myRect := drawingWindow^.portRect;
  77.         myRect.right := myRect.right - SCROLL_BAR_PIXELS;
  78.         EraseRect(myRect);
  79.  
  80.         currentPicture := PicHandle(GetIndResource('PICT', GetCtlValue(gScrollBarHandle)));
  81.  
  82.         if currentPicture = nil then
  83.             ErrorHandler(CANT_LOAD_PICT);
  84.  
  85.         CenterPict(currentPicture, myRect);
  86.  
  87.         drawingClipRect := drawingWindow^.portRect;
  88.         drawingClipRect.right := drawingClipRect.right - SCROLL_BAR_PIXELS;
  89.         ClipRect(drawingClipRect);
  90.  
  91.         DrawPicture(currentPicture, myRect);
  92.  
  93.         SetClip(tempRgn);
  94.         DisposeRgn(tempRgn);
  95.     end;
  96.  
  97.  
  98. {-------------------------------->    ScrollProc    <---}
  99.  
  100.     procedure ScrollProc (theControl: ControlHandle; theCode: INTEGER);
  101.         var
  102.             curControlValue, maxControlValue, minControlValue: INTEGER;
  103.     begin
  104.         maxControlValue := GetCtlMax(theControl);
  105.         curControlValue := GetCtlValue(theControl);
  106.         minControlValue := GetCtlMin(theControl);
  107.  
  108.         case theCode of
  109.             inPageDown, inDownButton: 
  110.                 if curControlValue < maxControlValue then
  111.                     curControlValue := curControlValue + 1;
  112.             inPageUp, inUpButton: 
  113.                 if curControlValue > minControlValue then
  114.                     curControlValue := curControlValue - 1;
  115.         end;
  116.         SetCtlValue(theControl, curControlValue);
  117.     end;
  118.  
  119.  
  120. {-------------------------------->    SetUpScrollBar    <---}
  121.  
  122.     procedure SetUpScrollBar;
  123.         var
  124.             vScrollRect: Rect;
  125.             numPictures: INTEGER;
  126.     begin
  127.         numPictures := CountResources('PICT');
  128.         if numPictures <= 0 then
  129.             ErrorHandler(NO_PICTS);
  130.         vScrollRect := gPictWindow^.portRect;
  131.         vScrollRect.top := vScrollRect.top - 1;
  132.         vScrollRect.bottom := vScrollRect.bottom + 1;
  133.         vScrollRect.left := vScrollRect.right - SCROLL_BAR_PIXELS + 1;
  134.         vScrollRect.right := vScrollRect.right + 1;
  135.         gScrollBarHandle := NewControl(gPictWindow, vScrollRect, NIL_TITLE, VISIBLE, START_VALUE, MIN_VALUE, numPictures, scrollBarProc, NIL_REF_CON);
  136.     end;
  137.  
  138.  
  139. {-------------------------------->    HandleMouseDown    <---}
  140.  
  141.     procedure HandleMouseDown;
  142.         var
  143.             whichWindow: WindowPtr;
  144.             thePart: INTEGER;
  145.             thePoint: Point;
  146.             theControl: ControlHandle;
  147.     begin
  148.         thePart := FindWindow(gTheEvent.where, whichWindow);
  149.         case thePart of
  150.             inSysWindow: 
  151.                 SystemClick(gTheEvent, whichWindow);
  152.             inDrag: 
  153.                 DragWindow(whichWindow, gTheEvent.where, screenBits.bounds);
  154.             inContent: 
  155.                 begin
  156.                     thePoint := gTheEvent.where;
  157.                     GlobalToLocal(thePoint);
  158.                     thePart := FindControl(thePoint, whichWindow, theControl);
  159.                     if theControl = gScrollBarHandle then
  160.                         begin
  161.                             if thePart = inThumb then
  162.                                 begin
  163.                                     thePart := TrackControl(theControl, thePoint, nil);
  164.                                     UpdateMyWindow(whichWindow);
  165.                                 end
  166.                             else
  167.                                 begin
  168.                                     thePart := TrackControl(theControl, thePoint, @ScrollProc);
  169.                                     UpdateMyWindow(whichWindow);
  170.                                 end;
  171.                         end;
  172.                 end;
  173.             inGoAway: 
  174.                 gDone := TRUE;
  175.         end;
  176.     end;
  177.  
  178.  
  179. {-------------------------------->    HandleEvent    <---}
  180.  
  181.     procedure HandleEvent;
  182.         var
  183.             dummy: BOOLEAN;
  184.     begin
  185.         if gWNEImplemented then
  186.             dummy := WaitNextEvent(everyEvent, gTheEvent, MIN_SLEEP, nil)
  187.         else
  188.             begin
  189.                 SystemTask;
  190.                 dummy := GetNextEvent(everyEvent, gTheEvent);
  191.             end;
  192.  
  193.         case gTheEvent.what of
  194.             mouseDown: 
  195.                 HandleMouseDown;
  196.             updateEvt: 
  197.                 begin
  198.                     BeginUpdate(WindowPtr(gTheEvent.message));
  199.                     DrawControls(WindowPtr(gTheEvent.message));
  200.                     UpdateMyWindow(WindowPtr(gTheEvent.message));
  201.                     EndUpdate(WindowPtr(gTheEvent.message));
  202.                 end;
  203.         end;
  204.     end;
  205.  
  206.  
  207. {-------------------------------->    MainLoop    <---}
  208.  
  209.     procedure MainLoop;
  210.     begin
  211.         gDone := FALSE;
  212.  
  213.         gWNEImplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPL_TRAP_NUM, ToolTrap));
  214.         while (gDone = FALSE) do
  215.             HandleEvent;
  216.     end;
  217.  
  218.  
  219. {-------------------------------->    WindowInit    <---}
  220.  
  221.     procedure WindowInit;
  222.     begin
  223.         gPictWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
  224.  
  225.         if gPictWindow = nil then
  226.             ErrorHandler(NO_WIND);
  227.  
  228.         SelectWindow(gPictWindow);
  229.         ShowWindow(gPictWindow);
  230.         SetPort(gPictWindow);
  231.     end;
  232.  
  233.  
  234. {-------------------------------->    Pager    <---}
  235.  
  236. begin
  237.     WindowInit;
  238.     SetUpScrollBar;
  239.  
  240.     MainLoop;
  241. end.